home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / windows4 / plx17.zip / PLX.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-14  |  28KB  |  861 lines
  1. {Program Listing Express - An ASCII Print Program}
  2. {Begun 8/2/91} {Rel 1.7 6/6/92}
  3. program PLXpress;
  4. {$D Copyright 1991,1992 Doug Overmyer}
  5. {$S-}{$R plx.RES}{$R-}{$X+}{$V-}
  6. uses WinTypes,WinProcs,Strings,WObjects,TextStrm,WFPlus,
  7.     Buttons,SclpText,Printer,commdlg,Win31,Meter;
  8. const
  9.   cm_FOpen   = 101;     {menuitem FileOpen    }
  10.   cm_FPrint  = 102;     {menuitem FilePrint   }
  11.   cm_FSetUp  = 103;     {menuitem FilePageSetup}
  12.   cm_FExit   = 104;     {menuitem FileExit    }
  13.   cm_SetFont = 111;     {menuitem TextFont    }
  14.   id_But1    = 201;     {User defined button 1 iconbar}
  15.   id_But2    = 202;     {      "             2 iconbar}
  16.   id_But3    = 203;     {      "             3 iconbar}
  17.   id_But4    = 204;     {      "             3 iconbar}
  18.   id_But5    = 205;     {      "             5 iconbar}
  19.   id_St1     = 401;     {Static text 1         icon bar}
  20.   id_St2     = 402;     {Static text 2         icon bar}
  21.   id_D2EC1   = 603;     {Edit Control 1 in Dlg2 Margin.left}
  22.   id_D2EC2   = 605;     {             2         Margin.right}
  23.   id_D2EC3   = 607;     {             3         Margin.top}
  24.   id_D2EC4   = 609;     {             4         Margin.bottom}
  25.   id_D2EC5   = 617;     {             5         tabsize}
  26.   id_D2EC6   = 621;     {             6         Header text}
  27.   id_D2EC7   = 622;     {             7         Footer Text}
  28.   id_D2CB1   = 612;     {Check box 1 in Dlg2    Format.ShowRuler}
  29.   id_D2CB2   = 613;     {Check box 2 in Dlg2    Format.ShowFName}
  30.   id_D2CB3   = 614;     {Check box 3 in Dlg2    Format.ShowDTStamp}
  31.   id_D2CB4   = 615;     {Check box 4 in Dlg2    Format.ShowPageNum}
  32.   id_D2CB5   = 619;     {Check box 5 in Dlg2    Format.ShowLineNum}
  33.   id_D2CB6   = 620;     {Check box 6 in dlg2    format.UseCCB}
  34.   idm_About  = 801;     {menu id for PLX_About menu}
  35.   idm_RunCP  = 802;     {menu id for run control panel}
  36. {************************  Types    ************************}
  37. type
  38.     TPLXApplication = object(TApplication)
  39.   procedure InitMainWindow;virtual;
  40.   function ProcessMDIAccels(var Message:TMsg):Boolean;virtual;
  41. end;
  42.  
  43.     FormatRec = record
  44.   MarginL,MarginR,MarginT,MarginB,TabSize:Array[0..4] of Char;
  45.   Header,Footer:Array[0..131] of Char;
  46.   ShowRuler,ShowFName,ShowDTStamp,ShowPageNum,ShowLineNum,UseCCB:Word;
  47. end;
  48.  
  49.     PTextObj = ^TTextObj;
  50.   TTextObj = object(TObject)
  51.   Text:PChar;
  52.       constructor Init(NewText:PChar);
  53.     destructor Done;virtual;
  54.     end;
  55.  
  56. PPLXAboutDlg = ^TPLXAboutDlg;
  57. TPLXAboutDlg = object(TDialog)
  58.   CurBrush:HBrush;
  59.   Logo:HBitmap;
  60.   constructor Init(aParent:PWindowsObject;AName:PChar;Brush:HBrush);
  61.     procedure WMCtlColor(var Msg:TMessage);virtual wm_First+wm_CtlColor;
  62.   procedure SetupWindow;virtual;
  63.   function CanClose:Boolean;virtual;
  64. end;
  65.  
  66. PPLXPrinter = ^TPLXPrinter;
  67. TPlxPrinter = object(TLPrinter)
  68.     HeadLine1:Array[0..210] of Char;
  69.   Format:FormatRec;
  70.     procedure DoHeader;virtual;
  71.   procedure DoFooter;virtual;
  72.   function SetHeader1(NewHeadLine1:PChar):Boolean;virtual;
  73. end;
  74.  
  75.                       {MainWindow of Application}
  76. PPLXWindow = ^TPLXWindow;
  77. TPLXWindow = object(TWindow)
  78.     DispWin:PEdit;                   {child window displaying sample lines from infile}
  79.   TheIcon:HIcon;
  80.   BN:Array[0..5] of PODButton;  {icon bar buttons}
  81.   FileName:Array[0..79] of Char;   {infile name}
  82.   CharsInFile:LongInt;             {chars in infile}
  83.   St1,St2:PSText;
  84.   FontSize:Integer;       {Current font size in tenths of a point}
  85.   Records:PCollection;     {Collection of Infile records}
  86.   Format:FormatRec;        {format fields}
  87.   LogFont:TLogFont;
  88.   IsProfileDirty:Boolean;
  89.   Br1:HBrush;
  90.   Buf3:PChar;
  91.   Helv:HFont;
  92.     constructor Init(AParent:PWindowsObject;ATitle:PChar);
  93.   destructor Done;virtual;
  94.   procedure SetupWindow;virtual;
  95.   procedure Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);virtual;
  96.   procedure SetStaticText;
  97.   procedure LoadDispWin;
  98.   procedure    WMDrawItem(var Msg:TMessage);virtual wm_First + wm_DrawItem;
  99.   procedure WMSize(var Msg:TMessage);virtual wm_First+wm_Size;
  100.   procedure IDBut1(var Msg:TMessage);virtual id_First+id_But1; {Print}
  101.     procedure IDBut2(var Msg:TMessage);virtual id_First+id_But2; {FileOpen}
  102.   procedure IDBut3(var Msg:TMessage);virtual id_First+id_But3; {PageSetup}
  103.   procedure    IDBut4(var Msg:TMessage);virtual id_First+id_But4; {SelectFont}
  104.   procedure IDBut5(var Msg:TMessage);virtual id_First+id_But5; {Exit}
  105.   procedure    FilePrint;virtual ;
  106.   procedure    WMSysCommand(var Msg:TMessage);virtual wm_First+wm_SysCommand;
  107.   procedure CMFOpen(var Msg:TMessage);virtual cm_First+cm_FOpen;
  108.   procedure CMFPrint(var Msg:TMessage);virtual cm_First+cm_FPrint;
  109.     procedure CMFSetUp(var Msg:TMessage);virtual cm_First+cm_FSetUp;
  110.     procedure CMFExit(var Msg:TMessage);virtual cm_First+cm_FExit;
  111.     procedure CMSetFont(var Msg:TMessage);virtual cm_First+cm_SetFont;
  112.   procedure GetProfileValues;virtual;
  113.   procedure WriteProfileValues;virtual;
  114. end;
  115. {*********************  Functions  *******************************}
  116. function StrTok(P:PChar;C:Char):PChar;
  117. const
  118.     Next:Pchar = nil;
  119. begin
  120.     if P = NIL then P := Next;
  121.   if P <> NIL then
  122.       begin
  123.       Next := StrScan(P,C);
  124.       If Next <> NIL then
  125.           begin
  126.         Next^ := #0;
  127.         Next := Next+1;
  128.           end;
  129.       end;
  130.   StrTok := P;
  131. end;
  132. procedure Take5;
  133. var MsgP:TMsg;
  134. begin
  135.     while PeekMessage(MsgP,0,0,0,PM_REMOVE) do
  136.       begin
  137.     if MsgP.Message = WM_QUIT then
  138.         begin
  139.       Application^.Done;
  140.       Halt;
  141.       end;
  142.     TranslateMessage(MsgP);
  143.     DispatchMessage(MsgP);
  144.     end
  145. end;
  146. {***********************  Methods    *******************************}
  147. procedure TPLXApplication.InitMainWindow;
  148. begin
  149.     MainWindow := New(PPLXWindow,Init(nil,'PLX'));
  150. end;
  151. {This is a hack to avoid a mysterious error}
  152. function TPLXApplication.ProcessMDIAccels(var Message:TMsg):Boolean;
  153. begin
  154.     ProcessMDIAccels:= False;
  155. end;
  156. {**********************  TPLXWindow  *******************************}
  157. constructor TPLXWindow.Init(AParent:PWindowsObject;ATitle:PChar);
  158. var
  159.   TheBmp:HBitmap;
  160. begin
  161.     TWindow.Init(AParent,ATitle);
  162.   Attr.Menu := LoadMenu(HInstance,'PLX_Menu');
  163.   Attr.X := 20; Attr.Y := 25; Attr.W := 595; Attr.H := 260;
  164.   Bn[2] := New(PODButton,Init(@Self,id_But2,'File Open',0,0,50,50,False,'PLX_Bn2',nil));
  165.   Bn[3] := New(PODButton,Init(@Self,id_But3,'Page Setup',50,0,100,50,False,'PLX_Bn3',nil));
  166.   Bn[4] := New(PODButton,Init(@Self,id_But4,'Font',150,0,50,50,False,'PLX_Bn4',nil));
  167.   Bn[1] := New(PODButton,Init(@Self,id_But1,'Print',200,0,50,50,False,'PLX_Bn1',nil));
  168.   Bn[5] := New(PODButton,Init(@Self,id_But5,'Exit',250,0,50,50,False,'PLX_Bn5',nil));
  169.   St1 := New(PSText,Init(@Self,id_St1,'',310,3,260,20,sr_Recessed,dt_Center or dt_VCenter));
  170.   St2 := New(PSText,Init(@Self,id_St2,'',310,26,260,20,sr_Recessed,dt_Center or dt_VCenter));
  171.   DispWin := New(PEdit,Init(@Self,200,nil,0,0,0,0,0,True));
  172.   with DispWin^.Attr do
  173.        Style := Style  or es_readonly ;
  174.   Records := New(PCollection,Init(1000,500));
  175.   CharsInFile := 0;
  176.   StrCopy(FileName,'');
  177.   Format.ShowRuler := 1;Format.ShowFName := 1;
  178.     Format.ShowDTStamp := 1;Format.ShowPageNum := 1;
  179.   Format.ShowLineNum := 1;Format.UseCCB := 0;
  180.   StrCopy(Format.Header,'');StrCopy(Format.Footer,'');
  181.   Strcopy(Format.TabSize,'2');
  182.   GetProfileValues;
  183.   IsProfileDirty := False;
  184.   TheBmp :=LoadBitmap(HInstance,'PLX_Brush1');
  185.   Br1 :=CreatePatternBrush(TheBmp);
  186.   DeleteObject(TheBmp);
  187. end;
  188.  
  189. procedure TPLXWindow.SetupWindow;
  190. var
  191.     SysMenu:hMenu;
  192.   OEMFixFont:hFont;
  193.   Indx:Word;
  194.   LFont:TLogFont;
  195.   XStyle:LongInt;
  196. begin
  197.     TWindow.SetupWindow;
  198.     SetClassWord(HWindow,GCW_HIcon,LoadIcon(HInstance,'PLX_Icon'));
  199.   Sysmenu := GetSystemMenu(hWindow,false);
  200.   AppendMenu(SysMenu,MF_Separator,0,nil);
  201.   AppendMenu(SysMenu,0,idm_RunCP,'Run Control Panel');
  202.   AppendMenu(Sysmenu,0,idm_About,'About...');
  203.   OEMFixFont := GetStockObject(OEM_Fixed_Font);
  204.   SendMessage(DispWin^.hWindow,wm_SetFont,OEMFixFont,LongInt(1));
  205.   GetObject(GetStockObject(System_Font),sizeof(LogFont),@LFont);
  206.   StrCopy(LFont.lfFaceName,'Helv');
  207.     LFont.lfHeight := round(LFont.lfHeight * 2 / 3);
  208.   LFont.lfWidth := 0;
  209.   LFont.lfPitchAndFamily := 0;
  210.   Helv := CreateFontIndirect(LFont);
  211.   SetStaticText;
  212.   XStyle := GetWindowLong(DispWin^.HWindow,GWL_STYLE);
  213. end;
  214.  
  215. procedure TPLXWindow.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
  216. var
  217.     ThePen:HPen;
  218.   TheBrush :HBrush;
  219.   OldBrush :HBrush;
  220.   OldPen:HPen;
  221. begin
  222.     TheBrush := GetStockObject(LtGray_Brush);
  223.     ThePen := CreatePen(ps_Solid,1,$00000000);
  224.   OldPen := SelectObject(PaintDC,ThePen);
  225.   OldBrush := SelectObject(PaintDC,TheBrush);
  226.   Rectangle(PaintDC,0,0,1024,50);
  227.   SelectObject(PaintDC,OldBrush);
  228.   SelectObject(PaintDC,OldPen);
  229.   DeleteObject(ThePen);
  230. end;
  231.  
  232. procedure    TPLXWindow.WMDrawItem(var Msg:TMessage);
  233. var
  234.     PDIS : ^TDrawItemStruct;
  235. begin
  236.     PDIS := Pointer(Msg.lParam);
  237.     case PDIS^.CtlType of
  238.         odt_Button:
  239.         case PDIS^.CtlID of
  240.       id_But1..id_But5:BN[PDIS^.CtlID-200]^.DrawItem(Msg);
  241.         end;
  242.     end;
  243. end;
  244.  
  245. destructor TPLXWindow.Done;
  246. begin
  247.  if IsProfileDirty then
  248.       WriteProfileValues;
  249.   Dispose(Records,Done);
  250.     DeleteObject(Br1);
  251.     DeleteObject(Helv);
  252.   TWindow.Done;
  253. end;
  254.  
  255. procedure TPLXWindow.WMSize(var Msg:TMessage);
  256. begin
  257.     SetWindowPos(DispWin^.HWindow,0,-1,50,
  258.        (Msg.LParamLo )+1,(Msg.LParamHi-50),swp_NoZOrder);
  259. end;
  260.  
  261. procedure TPLXWindow.IDBut1(var Msg:TMessage);
  262. var
  263.   PD:TPrintDlg;
  264. begin
  265.   with PD do
  266.       begin
  267.     lStructSize := sizeof(TPrintDlg);
  268.     hWndOwner := HWindow;
  269.     hDevMode := THandle(nil);
  270.     hDevNames := THandle(nil);
  271.     Flags := PD_NOPAGENUMS or PD_NOSELECTION or PD_ALLPAGES or PD_HIDEPRINTTOFILE;
  272.     hInstance := THandle(nil);
  273.     nCopies := 1;
  274.     end;
  275.   if (PrintDlg(PD)) then
  276.     FilePrint;
  277. end;
  278.  
  279. procedure TPLXWindow.IDBut2(var Msg:TMessage);
  280. const
  281.   szFilter:Array[0..8] of Char ='*.*'#0'*.*'#0#0;
  282. var
  283.   InFile :PTextStream;
  284.   InRecord:PChar;
  285.   PctMeter:PMeterWindow;
  286.   Division,Pctdone:Integer;
  287.   indx1,Indx2 : Integer;
  288.   hTab :Integer;
  289.   pBuf3:PChar;
  290.   Indx:Word;
  291.   OEMFixFont:HFont;
  292.   pBuf:PChar;
  293.   Dir,Name,Ext:Array[0..79] of Char;
  294.     szDirName:Array[0..256] of Char;
  295.   szFile,szFileTitle:Array[0..256] of Char;
  296.   OFN:TOpenFileName;
  297.   Ptr:PChar;
  298. begin
  299.     DispWin^.CloseWindow;
  300.   DispWin := New(PEdit,Init(@Self,200,nil,0,0,0,0,0,True));
  301.   with DispWin^.Attr do
  302.        Style := Style OR ES_READONLY ;
  303.   Application^.MakeWindow(DispWin);
  304.   OEMFixFont := GetStockObject(OEM_Fixed_Font);
  305.   SendMessage(DispWin^.hWindow,wm_SetFont,OEMFixFont,LongInt(1));
  306.     Division := 10;
  307.     StrCopy(FileName,'*.*');
  308.   if Records^.Count > 0 then
  309.       begin
  310.       Dispose(Records,Done);
  311.     Records := New(PCollection,Init(1000,500));
  312.       end;
  313.   CharsInFile := 0;
  314.  
  315.     Ptr := @szFilter;
  316.     StrCopy(szFile,'');
  317.   OFN.lStructSize := sizeof(TOpenFileName);
  318.   OFN.hWndOwner := HWindow;
  319.   OFN.lpStrFilter := Ptr;
  320.   OFN.lpStrCustomFilter := nil;
  321.   OFN.nMaxCustFilter := 0;
  322.   OFN.nFilterIndex := LongInt(1);
  323.   OFN.lpStrFile := szFile;
  324.   OFN.nMaxFile := sizeof(szFile);
  325.   OFN.lpstrfileTitle := szFileTitle;
  326.   OFN.nMaxFileTitle := sizeof(szFileTitle);
  327.   OFN.lpstrInitialDir := NIL;
  328.   OFN.lpStrTitle := 'Open File';
  329.   OFN.flags := OFN_Pathmustexist or OFN_Filemustexist;
  330.   OFN.nFileOffset := 0;
  331.   OFN.nFileExtension := 0;
  332.   OFN.lpstrDefext := nil;
  333.   If Not(GetOpenFileName(OFN)) then
  334.       begin
  335.     SetStaticText;
  336.     Exit;
  337.     end;
  338.   if StrIComp(szFile,'*.*') <> 0 then
  339.       begin
  340.     StrCopy(FileName,szFile);
  341.       InRecord :=MemAlloc(9999);
  342.       GetMem(Buf3,35000);
  343.       pBuf3 := Buf3;
  344.       StrCopy(Buf3,'');
  345.     PctMeter := New(PMeterWindow,Init(@Self,'Working...'));
  346.     Application^.MakeWindow(PctMeter);
  347.     PctMeter^.Draw(0);
  348.     InFile := New(PTextStream,Init(FileName,stOpen,1024));
  349.     CharsInFile := InFile^.CharsToRead;
  350.     While NOT InFile^.IsEOF do
  351.         begin
  352.         StrCopy(InRecord,InFile^.GetNext);
  353.       if InRecord = nil then          {avoid storing null pointers }
  354.                 StrCopy(InRecord,' ');
  355.       Records^.Insert(New(PTextObj,Init(InRecord)));
  356.       if (((InFile^.CharsRead)+(2*Records^.Count)) < 32768) then
  357.           pBuf3 := StrECopy(StrECopy(pBuf3,InRecord),#13#10#0);
  358.       if InFile^.GetPctDone > Division then
  359.           begin
  360.           PctMeter^.Draw(Division);
  361.           Inc(Division,5);
  362.           end;
  363.       Take5;
  364.       end;
  365.     PctMeter^.CloseWindow;
  366.  
  367.       if ((InFile^.CharsRead)+(2*Records^.Count)) > 32768 then
  368.           StrECopy(pBuf3,'Rest of file not displayed...'#13#10#0);
  369.       FreeMem(InRecord,9999);
  370.       Dispose(InFile,Done);
  371.         LoadDispWin;
  372.       end;
  373.   SetStaticText;
  374. end;
  375.  
  376. procedure TPLXWindow.LoadDispWin;
  377. var
  378.   Indx,TabSize:Integer;
  379.   Cursor:hCursor;
  380.   CRLF :Array[0..2] of Char;
  381.   IntArray:Array[0..11] of Integer;
  382.   CR:TRect;
  383. begin
  384.     SetCursor(LoadCursor(0,Idc_Wait));
  385.   SendMessage(DispWin^.HWindow,wm_SetText,word(0),LongInt(Buf3));
  386.      GetClientRect(HWindow,CR);
  387.     SetWindowPos(DispWin^.HWindow,0,-1,50,
  388.        (CR.Right-CR.Left )+1,(CR.Bottom-CR.Top-50),swp_NoZOrder);
  389.   FreeMem(Buf3,35000);
  390.   DispWin^.Scroll(0,-32000);
  391.     SetCursor(LoadCursor(0,Idc_Arrow));
  392.   Val(Format.TabSize,tabsize,Indx);
  393.   for Indx := 0 to 11 do
  394.       IntArray[Indx] := Indx*4*tabsize;
  395.   SendMessage(DispWin^.HWindow,em_SetTabStops,word(12),LongInt(@IntArray));
  396.   InvalidateRect(DispWin^.HWindow,nil,False);
  397. end;
  398.  
  399. procedure TPLXWindow.IDBut3(var Msg:TMessage);
  400. var
  401.     TotChars:Integer;
  402.   Dlg2:PDialog;
  403.   EC1,EC2,EC3,EC4,EC5,EC6,EC7:PEdit;
  404.   CB1,CB2,CB3,CB4,CB5,CB6:PCheckBox;
  405. begin
  406.     Dlg2 := New(PDialog,Init(@Self,'PLX_Dlg2'));
  407.   New(EC1,InitResource(Dlg2,id_D2EC1,5));
  408.   New(EC2,InitResource(Dlg2,id_D2EC2,5));
  409.   New(EC3,InitResource(Dlg2,id_D2EC3,5));
  410.   New(EC4,InitResource(Dlg2,id_D2EC4,5));
  411.   New(EC5,InitResource(Dlg2,id_D2EC5,5));
  412.   New(EC6,InitResource(Dlg2,id_D2EC6,132));
  413.   New(EC7,InitResource(Dlg2,id_D2EC7,132));
  414.   New(CB1,InitResource(Dlg2,id_D2CB1));
  415.   New(CB2,InitResource(Dlg2,id_D2CB2));
  416.   New(CB3,InitResource(Dlg2,id_D2CB3));
  417.   New(CB4,InitResource(Dlg2,id_D2CB4));
  418.   New(CB5,InitResource(Dlg2,id_D2CB5));
  419.   New(CB6,InitResource(Dlg2,id_D2CB6));
  420.   Dlg2^.TransferBuffer := @Format;
  421.   if (Application^.ExecDialog(Dlg2) = 1) then
  422.         IsProfileDirty := True;
  423. end;
  424.  
  425. procedure TPLXWindow.IDBut4(var Msg:TMessage);
  426. var
  427.     CF:TChooseFont;
  428.   ThePrinter:PPLXPrinter;
  429.   IC:HDC;
  430. begin
  431.   ThePrinter := New(PPLXPrinter,Init);
  432.   IC := ThePrinter^.GetIC;
  433.   with CF do
  434.       begin
  435.     lStructSize := sizeof(TChooseFont);
  436.     hDC := IC;
  437.     hWndOwner := HWindow;
  438.     lpLogfont:= @LogFont;
  439.     iPointSize := FontSize    ;  {in tenths of a point}
  440.     Flags := CF_ScreenFonts or CF_EFFECTS or CF_INITTOLOGFONTSTRUCT
  441.                      or CF_PRINTERFONTS;
  442.     rgbColors:=RGB(255,0,0);
  443.     lCustData := 0;
  444.     @lpfnHook:= Pointer(0);
  445.     end;
  446.   if ChooseFont(CF) then
  447.       begin
  448.       FontSize := CF.iPointSize;
  449.       IsProfileDirty := True;
  450.     SetStaticText;
  451.     end;
  452.   ThePrinter^.DeleteIC;
  453.   Dispose(ThePrinter,Done);
  454. end;
  455.  
  456. procedure TPLXWindow.IDBut5(var Msg:TMessage);
  457. begin
  458.   CloseWindow;
  459. end;
  460.  
  461.  
  462. procedure TPLXWindow.FilePrint;
  463. var
  464.     aPtr : pPLXPrinter;
  465.   indx: Integer;
  466.   OldFont,NewFont:hFont;
  467.   szSize:Array[0..7] of Char;
  468.   Buf1,pBuf:PChar;
  469.   szIndx:Array[0..5] of Char;
  470.   OutRecord:pTextObj;
  471.   ExpRec:PChar;
  472.   CCB:Char;
  473.   IC:HDC;
  474.   LPX,LPY:Integer;
  475.   rVal:Real;
  476.   Err,Hold,Tabsize:Integer;
  477. begin
  478.     if Records^.Count = 0  then
  479.       begin
  480.       MessageBox(hWindow,'You need to open a file - click the disk icon',
  481.             'Alert',mb_OK or mb_IconExclamation);
  482.     exit;
  483.     end;
  484.     if StrLen(LogFont.lfFaceName) = 0 then
  485.       begin
  486.       MessageBox(hWindow,'You need to select a font - click the font button',
  487.             'Alert',mb_OK or mb_IconExclamation);
  488.     exit;
  489.     end;
  490.     aPtr := New(pPLXPrinter,Init);
  491.     indx := 0;
  492.   GetMem(Buf1,16000);
  493.   GetMem(ExpRec,16000);
  494.   if aPtr^.PrnStart('PLX') then
  495.       begin
  496.     Val(Format.MarginL,rVal,err);
  497.       aPtr^.SetMarginL(round(rVal * aPtr^.LogPixX)) ;{margin in device pixels}
  498.     Val(Format.MarginR,rVal,err);
  499.         aPtr^.SetMarginR(round(rVal * aPtr^.LogPixX)) ;{margin in device pixels}
  500.     Val(Format.MarginT,rVal,err);
  501.     aPtr^.SetMarginT(round(rVal * aPtr^.LogPixY)) ;{margin in device pixels}
  502.     Val(Format.MarginB,rVal,err);
  503.       aPtr^.SetMarginB(round(rVal * aPtr^.LogPixY)) ;{margin in device pixels}
  504.     Hold := LogFont.lfHeight;
  505.     LogFont.lfHeight := Round(FontSize * (aPtr^.LogPixY / 720));
  506.     NewFont := CreateFontIndirect(LogFont);
  507.     OldFont := aPtr^.SetFont(NewFont);
  508.     aPtr^.SetHeader1(FileName);
  509.         Move(Format,aPtr^.Format,sizeof(FormatRec));
  510.     aPtr^.SetupPage;
  511.     StrCopy(szIndx,'');
  512.     Val(Format.Tabsize,Tabsize,Err);
  513.     for indx := 0 to  (Records^.Count-1) do
  514.         begin
  515.       OutRecord := Records^.AT(indx);
  516.       if OutRecord^.Text <> nil then           {avoid null pointer}
  517.           StrCopy(Buf1,OutRecord^.Text)
  518.       else
  519.           StrCopy(Buf1,' ');
  520.       pBuf := Buf1;
  521.       if Format.ShowLineNum = 1 then          {setup line numbers}
  522.           Str((indx+1):5,szIndx)
  523.       else
  524.           StrCopy(szIndx,'');
  525.       if (Format.UseCCB = 1)  then            {setup CCB for linespacing}
  526.         begin
  527.         CCB := Buf1[0];
  528.         pBuf:= Buf1+1;
  529.         end
  530.       else
  531.           CCB := ' ';
  532.             ExpandTabs(pBuf,ExpRec,Tabsize);                {expand tabs}
  533.             StrCat(StrCat(StrCopy(Buf1,szIndx),' '),ExpRec);
  534.  
  535.       case CCB of                         {do line spacing using CCB}
  536.                 '1':    aPtr^.NewPage;
  537.                 '0':    aPtr^.PrintLine(' ');
  538.                 '-':    begin
  539.                             aPtr^.PrintLine(' ');
  540.                             aPtr^.PrintLine(' ');
  541.               end;
  542.         end;
  543.       aPtr^.printLine(Buf1);
  544.       end;
  545.  
  546.       APtr^.DoFooter;
  547.       OldFont := aPtr^.SetFont(OldFont);      {restore the old font}
  548.       DeleteObject(NewFont);
  549.       aPtr^.PrnStop;
  550.       Dispose(aPtr,Done);
  551.     end; {end if}
  552.   FreeMem(Buf1,16000);
  553.   FreeMem(ExpRec,16000);
  554.   LogFont.lfHeight := Hold;
  555. end;
  556.  
  557. procedure    TPLXWindow.WMSysCommand(var Msg:TMessage);
  558. begin
  559.     case Msg.Wparam of
  560.         idm_About:
  561.             Application^.ExecDialog(New(PPLXAboutDlg,Init(@Self,'PLX_About',Br1)));
  562.     idm_RunCP:
  563.             begin
  564.         WinExec('Control',1);
  565.       StrCopy(LogFont.lfFaceName,'');{Force a reselection of current font}
  566.         end;
  567.        else
  568.            DefWndProc(Msg);
  569.        end;
  570. end;
  571.  
  572. procedure TPLXWindow.SetStaticText;
  573. var
  574.   I,nBytes,LPY: Integer;
  575.   Buf:Array[0..80] of Char;
  576.   szLines:Array[0..5] of Char;
  577.   FontMetrics:TTextMetric;
  578.   szBytes:Array[0..7] of Char;
  579.   FormatRec : record
  580.       lines:Integer;
  581.     Bytes:LongInt;
  582.     FaceName:PChar;
  583.   end;
  584. begin                                             {build text display}
  585.   StrCopy(Buf,'File: ');
  586.     St1^.SetFont(Helv);
  587.     St1^.SetText(StrCat(Buf,FileName));
  588.     St2^.SetFont(Helv);
  589.   with FormatRec do
  590.       begin
  591.     lines := Records^.Count;
  592.     Bytes := CharsInFile;
  593.     Facename := LogFont.lfFaceName;
  594.     end;
  595.   wvsprintf(Buf,'lines:%i bytes:%li font:%s',FormatRec);
  596.   St2^.SetText(Buf);
  597. end;
  598.  
  599. procedure TPLXWindow.CMFOpen(var Msg:TMessage);
  600. begin
  601.     IDBut2(Msg);
  602. end;
  603.  
  604. procedure TPLXWindow.CMFPrint(var Msg:TMessage);
  605. begin
  606.     IDBut1(Msg);
  607.   end;
  608.  
  609. procedure TPLXWindow.CMFSetUp(var Msg:TMessage);
  610. begin
  611.     IDBut3(Msg);
  612. end;
  613.  
  614. procedure TPLXWindow.CMFExit(var Msg:TMessage);
  615. begin
  616.     IDBut5(Msg);
  617. end;
  618.  
  619. procedure TPLXWindow.CMSetFont(var Msg:TMessage);
  620. begin
  621.     IDBut4(Msg);
  622. end;
  623.  
  624. procedure TPLXWindow.GetProfileValues;
  625. var
  626.     Buf1:Array[0..80] of Char;
  627.   Indx,Errcode:Integer;
  628.   Found:Boolean;
  629. begin
  630.     Format.ShowRuler := GetPrivateProfileInt('PLX','ShowRuler',1,'PLX.INI');
  631.     Format.ShowFName := GetPrivateProfileInt('PLX','ShowFName',1,'PLX.INI');
  632.     Format.ShowDTStamp := GetPrivateProfileInt('PLX','ShowDTStamp',1,'PLX.INI');
  633.     Format.ShowPageNum := GetPrivateProfileInt('PLX','ShowPageNum',1,'PLX.INI');
  634.     Format.ShowLineNum := GetPrivateProfileInt('PLX','ShowLineNum',1,'PLX.INI');
  635.     Format.UseCCB := GetPrivateProfileInt('PLX','UseCCB',0,'PLX.INI');
  636.  
  637.     GetPrivateProfileString('PLX','MarginL','0',Format.MarginL,sizeof(Format.MarginL),'PLX.INI');
  638.      GetPrivateProfileString('PLX','MarginR','0',Format.MarginR,sizeof(Format.MarginR),'PLX.INI');
  639.     GetPrivateProfileString('PLX','MarginT','0',Format.MarginT,sizeof(Format.MarginT),'PLX.INI');
  640.     GetPrivateProfileString('PLX','MarginB','0',Format.MarginB,sizeof(Format.MarginB),'PLX.INI');
  641.     GetPrivateProfileString('PLX','TabSize','0',Format.TabSize,sizeof(Format.TabSize),'PLX.INI');
  642.  
  643.     GetPrivateProfileString('PLX','LogFont','',Buf1,SizeOf(Buf1),'PLX.INI');
  644.     FontSize:= GetPrivateProfileInt('PLX','FontSize',80,'PLX.INI');
  645.   with LogFont do
  646.       begin
  647.     GetPrivateProfileString('PLX','lfHeight','',Buf1,sizeof(Buf1),'PLX.INI');
  648.     Val(Buf1,lfHeight,errcode);
  649.     lfWidth := GetPrivateProfileInt('PLX','lfWidth',0,'PLX.INI');
  650.     lfEscapement := GetPrivateProfileInt('PLX','lfEscapement',0,'PLX.INI');
  651.     lfOrientation := GetPrivateProfileInt('PLX','lfOrientation',0,'PLX.INI');
  652.  
  653.     lfWeight := GetPrivateProfileInt('PLX','lfWeight',0,'PLX.INI');
  654.     lfItalic := GetPrivateProfileInt('PLX','lfItalic',0,'PLX.INI');
  655.     lfUnderLine := GetPrivateProfileInt('PLX','lfUnderline',0,'PLX.INI');
  656.     lfStrikeout := GetPrivateProfileInt('PLX','lfStrikeout',0,'PLX.INI');
  657.  
  658.     lfCharSet := GetPrivateProfileInt('PLX','lfCharSet',0,'PLX.INI');
  659.     lfOutPrecision := GetPrivateProfileInt('PLX','lfOutPrecision',0,'PLX.INI');
  660.     lfClipPrecision := GetPrivateProfileInt('PLX','lfClipPrecision',0,'PLX.INI');
  661.     lfQuality := GetPrivateProfileInt('PLX','lfQuality',0,'PLX.INI');
  662.     lfPitchAndFamily := GetPrivateProfileInt('PLX','lfPitchAndFamily',0,'PLX.INI');
  663.     GetPrivateProfileString('PLX','lfFaceName','',lfFaceName,sizeof(lfFaceName),'PLX.INI');
  664.   end;
  665.  
  666. end;
  667.  
  668. procedure TPLXWindow.WriteProfileValues;
  669. var
  670.     Buf:Array[0..5] of Char;
  671.   Bufl:Array[0..65] of Char;
  672. begin
  673.   Str(FontSize,Buf);
  674.   WritePrivateProfileString('PLX','FontSize',Buf,'PLX.INI');
  675.   Str(Format.ShowRuler,Buf);
  676.   WritePrivateProfileString('PLX','ShowRuler',Buf,'PLX.INI');
  677.   Str(Format.ShowFName,Buf);
  678.   WritePrivateProfileString('PLX','ShowFName',Buf,'PLX.INI');
  679.   Str(Format.ShowDTStamp,Buf);
  680.   WritePrivateProfileString('PLX','ShowDTStamp',Buf,'PLX.INI');
  681.   Str(Format.ShowPageNum,Buf);
  682.   WritePrivateProfileString('PLX','ShowPageNum',Buf,'PLX.INI');
  683.   Str(Format.ShowLineNum,Buf);
  684.   WritePrivateProfileString('PLX','ShowLineNum',Buf,'PLX.INI');
  685.   Str(Format.UseCCB,Buf);
  686.   WritePrivateProfileString('PLX','UseCCB',Buf,'PLX.INI');
  687.  
  688.   WritePrivateProfileString('PLX','MarginL',Format.MarginL,'PLX.INI');
  689.   WritePrivateProfileString('PLX','MarginR',Format.MarginR,'PLX.INI');
  690.   WritePrivateProfileString('PLX','MarginT',Format.MarginT,'PLX.INI');
  691.   WritePrivateProfileString('PLX','MarginB',Format.MarginB,'PLX.INI');
  692.   WritePrivateProfileString('PLX','TabSize',Format.TabSize,'PLX.INI');
  693.   with LogFont do
  694.       begin
  695.     Str(lfHeight,Buf);
  696.     WritePrivateProfileString('PLX','lfHeight',Buf,'PLX.INI');
  697.     Str(lfWidth,Buf);
  698.     WritePrivateProfileString('PLX','lfWidth',Buf,'PLX.INI');
  699.     Str(lfEscapement,Buf);
  700.     WritePrivateProfileString('PLX','lfEscapement',Buf,'PLX.INI');
  701.     Str(lfOrientation,Buf);
  702.     WritePrivateProfileString('PLX','lfOrientation',Buf,'PLX.INI');
  703.  
  704.     Str(lfWeight,Buf);
  705.     WritePrivateProfileString('PLX','lfWeight',Buf,'PLX.INI');
  706.     Str(lfItalic,Buf);
  707.     WritePrivateProfileString('PLX','lfItalic',Buf,'PLX.INI');
  708.     Str(lfUnderline,Buf);
  709.     WritePrivateProfileString('PLX','lfUnderline',Buf,'PLX.INI');
  710.     Str(lfStrikeout,Buf);
  711.     WritePrivateProfileString('PLX','lfStrikeout',Buf,'PLX.INI');
  712.  
  713.     Str(lfCharSet,Buf);
  714.     WritePrivateProfileString('PLX','lfCharSet',Buf,'PLX.INI');
  715.     Str(lfOutPrecision,Buf);
  716.     WritePrivateProfileString('PLX','lfOutPrecision',Buf,'PLX.INI');
  717.     Str(lfClipPrecision,Buf);
  718.     WritePrivateProfileString('PLX','lfClipPrecision',Buf,'PLX.INI');
  719.     Str(lfQuality,Buf);
  720.     WritePrivateProfileString('PLX','lfQuality',Buf,'PLX.INI');
  721.     Str(lfPitchAndFamily,Buf);
  722.     WritePrivateProfileString('PLX','lfPitchAndFamily',Buf,'PLX.INI');
  723.     WritePrivateProfileString('PLX','lfFaceName',lfFaceName,'PLX.INI');
  724.   end;
  725. end;
  726.  
  727. {************************  TPLXPrinter  ******************************}
  728. procedure  TPLXPrinter.DoHeader;
  729. var
  730.     Indx : Integer;
  731.     szSize:Array[0..7] of Char;
  732.     Buf1:Array[0..100] of Char;
  733.     szDateTime:Array[0..79] of Char;
  734.   szPageNumber:Array[0..5] of Char;
  735.   Ruler : Array[0..260] of Char;
  736. begin
  737.   if Format.ShowLineNum = 1 then
  738.       StrCopy(Ruler,'     ')
  739.   else
  740.       StrCopy(Ruler,'');
  741.     StrCat(Ruler,' |...+....1....+....2....+....3....+....4....+....5');
  742.   StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
  743.     StrCat(Ruler,'....+....1....+....2....+....3....+....4....+....5');
  744.   StrCat(Ruler,'....+....6....+....7....+....8....+....9....+....0');
  745.     StrCat(Ruler,'....+....1....+....2....+....3....+....4....+....5');
  746.   SetMarginL(Margin.left); {}
  747.   SetTOP;
  748.   if StrLen(Format.Header) <> 0 then
  749.       printLine(Format.Header);
  750.   StrCopy(Buf1,'');
  751.   GetDateTime(szDateTime);
  752.   if Format.ShowFName <> 0 then
  753.       StrCopy(Buf1,HeadLine1);
  754.   if Format.ShowDTStamp <> 0 then
  755.       StrCat(StrCat(Buf1,'  '),szDateTime);
  756.   Str(PageNumber:3,szPageNumber);
  757.   if Format.ShowPageNum <> 0 then
  758.       StrCat(StrCat(Buf1,'       page:'),szPageNumber);
  759.   if StrLen(Buf1) <> 0 then
  760.       printline(Buf1);
  761.   if Format.ShowRuler <> 0 then
  762.       PrintLine(Ruler);
  763.     FooterY := LineY;
  764. end;
  765.  
  766. function TPLXPrinter.SetHeader1(NewHeadLine1:PChar):Boolean;
  767. begin
  768.     StrCopy(HeadLine1,NewHeadLine1);
  769.   SetHeader1 := True;
  770. end;
  771.  
  772. procedure TPLXPrinter.DoFooter;
  773. begin
  774.     CurY := PageY - (Margin.Bottom +  FooterY + LineY);
  775.   IsFooter := True;
  776.   if StrLen(Format.Footer) > 0 then
  777.       PrintLine(Format.Footer);
  778.   IsFooter := False;
  779. end;
  780. {********************  TPLXAbout     **************************}
  781. constructor TPLXAboutDlg.Init(aParent:PWindowsObject;aName:PChar;Brush:HBrush);
  782. begin
  783.     TDialog.Init(AParent,aName);
  784.     CurBrush := Brush;
  785. end;
  786.  
  787. procedure TPLXAboutDlg.WMCTLCOLOR(var Msg: TMessage);
  788. const
  789.   as_AboutSt1 =   126;  {about dlg static text   }
  790.   as_AboutSt2 =   128;  {about dlg static blank static to draw upon}
  791. var
  792.     HSt1,HSt2:HWnd;
  793.   MemDC:hDC;
  794.   OldBitmap:HBitmap;
  795.   CR:TRect;
  796.   X,Y,W,H:Integer;
  797.   LogoMetrics:TBitmap;
  798. begin
  799.   case Msg.LParamHi of
  800.     ctlColor_Static:
  801.       begin
  802.           HSt1 := GetItemHandle(as_AboutSt1);
  803.           HSt2 := GetItemHandle(as_AboutSt2);
  804.         If HSt1 = Msg.lParamLo then
  805.             SetTextColor(Msg.WParam, RGB(0,0,255))
  806.         else  if HSt2 = Msg.lParamLO then
  807.             begin
  808.           MemDC := CreateCompatibleDC(Msg.WParam);
  809.           OldBitmap := SelectObject(MemDC,Logo);
  810.           GetClientRect(Msg.lParamLo,CR);
  811.           W:= CR.Right-CR.Left;H:= CR.Bottom-CR.Top;
  812.           GetObject(Logo,SizeOf(LogoMetrics),@LogoMetrics);
  813.           X := Max((W - LogoMetrics.bmWidth) div 2 , 0);
  814.           Y := Max((H - LogoMetrics.bmHeight) div 2 , 0);
  815.           BitBlt(Msg.WParam,X,Y,W,H,MemDc,0,0,SrcCopy);
  816.           SelectObject(MemDC,OldBitmap);
  817.           DeleteDC(MemDc);
  818.           end;
  819.         SetBkMode(Msg.WParam, transparent);
  820.         Msg.Result := GetStockObject(Null_Brush);
  821.       end;
  822.     ctlcolor_Dlg:
  823.       begin
  824.         SetBkMode(Msg.WParam, Transparent);
  825.         Msg.Result := CurBrush;
  826.       end;
  827.   else
  828.     DefWndProc(Msg);
  829.   end;
  830. end;
  831.  
  832. procedure TPLXAboutDlg.SetupWindow;
  833. begin
  834.     TDialog.SetupWindow;
  835.   Logo :=LoadBitmap(HInstance,'PLX_Logo');
  836. end;
  837.  
  838. function TPLXAboutDlg.CanClose:Boolean;
  839. begin
  840.   DeleteObject(Logo);
  841.   CanClose := True;
  842. end;
  843. {************************  TTextObj    *****************************}
  844. constructor TTextObj.Init(NewText:PChar);
  845. begin
  846.     Text := StrNew(NewText);
  847. end;
  848.  
  849. destructor TTextObj.Done;
  850. begin
  851.     StrDispose(Text);
  852. end;
  853. {***********************  MainLine  ********************************}
  854. var
  855.     PLXApp : TPLXApplication;
  856. begin
  857.     PLXApp.Init('PLX');
  858.     PLXApp.Run;
  859.     PLXApp.Done;
  860. end.
  861.